筆者每週需要寄回工作報告給主管，有了完整的紀錄下，轉出資料也是彈指之間，只是筆者的工作報告，有些包含了私人紀錄，不適合也不需要往上呈報，因此轉出程式中可以設定哪些類型的工作紀錄不需要轉出，透過適當的設定，就可以進行分類。

例如進行鐵人賽參賽，屬於私人紀錄：

轉出週報時，可以將此計畫相關的工作報告都不要轉出：

執行轉出後的畫面：

轉出的檔案內容，就不會有這資料的內容：

「匯出」的程式如下，其主要是由「週報匯出」查詢的SQL語句帶出預設語句，再替換條件值，最後產生的SQL語句寫入「週報匯出TEMP」查詢，然後用TransferSpreadsheet轉出Excel，再開啟Excel調整樣式把同日期進行合併，然後上表格線條：

Private Sub cmdExport_Click()
If IsNull(Date_Strat) Or IsNull(DATE_END) Then Exit Sub

Dim dbs As Database
Dim qdf As QueryDef

Set dbs = CurrentDb

Dim strFileName As String

Me.TextOrg.Value = dbs.QueryDefs("週報匯出").SQL
Me.TextFix.Value = Replace(TextOrg.Value, "#5/5/2013#", "#" & Format(Me.Date_Strat, "m/d/yyyy") & "#")
Me.TextFix.Value = Replace(Me.TextFix.Value, "#5/11/2013#", "#" & Format(Me.DATE_END, "m/d/yyyy") & "#")
If Me.Toggle_NotIn = True Then
    Me.TextFix.Value = Replace(Me.TextFix.Value, "Not In", "In")
    Me.TextFix.Value = Replace(Me.TextFix.Value, "((DailyWorkLog.TYPE)", "(((DailyWorkLog.TYPE)")
    Me.TextFix.Value = Replace(Me.TextFix.Value, "AND ((DailyWorkLog.WORK)", "OR ((DailyWorkLog.WORK)")
    Me.TextFix.Value = Replace(Me.TextFix.Value, "AND ((DailyWorkLog.SUBTYPE)", "OR ((DailyWorkLog.SUBTYPE)")
    Me.TextFix.Value = Replace(Me.TextFix.Value, "AND ((DailyWorkLog.PROJECT_INDEX)", "OR ((DailyWorkLog.PROJECT_INDEX)")
    Me.TextFix.Value = Replace(Me.TextFix.Value, "ORDER BY", ")ORDER BY")
End If
strFileName = "週報匯出" & Format(Me.Date_Strat, "YYYY-MM-DD") & "~" & Format(Me.DATE_END, "MM-DD")
dbs.QueryDefs("週報匯出TEMP").SQL = Me.TextFix.Value
'Set qdf = dbs.CreateQueryDef("週報匯出TEMP", Me.TextFix.Value)

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "週報匯出TEMP", Me.TextExpDir.Value & strFileName & ".xls", True

'  #5/5/2013# And #5/11/2013#

Dim ExcelApp As Excel.Application
Dim ExcelSheet As Excel.Worksheet
Set ExcelApp = New Excel.Application

ExcelApp.VISIBLE = True

ExcelApp.DisplayAlerts = False
ExcelApp.ScreenUpdating = False

ExcelApp.Workbooks.Open Me.TextExpDir.Value & strFileName & ".xls"
Set ExcelSheet = ExcelApp.Worksheets("週報匯出TEMP")


'上格子
ExcelSheet.UsedRange.Cells.Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Font
        .Name = "新細明體"
        .Size = 18
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
    End With

'合併日期
    Dim rngWrkRng As Range, rngWrkCel As Range
    Dim iFirstRow As Integer, iLastRow As Integer
    Dim vPrevVal As Variant
    
    Set rngWrkRng = ExcelSheet.Range("A1:A" & ExcelSheet.Range("A65535").End(xlUp).Row + 1)
    
    For Each rngWrkCel In rngWrkRng
        If iFirstRow = 0 Then
            iFirstRow = rngWrkCel.Row
            vPrevVal = rngWrkCel
        Else
            If vPrevVal = rngWrkCel Then
                
            Else
                With Range("A" & iFirstRow & ":A" & rngWrkCel.Row - 1)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .MergeCells = True
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                End With
                iFirstRow = rngWrkCel.Row
                vPrevVal = rngWrkCel
            End If
        End If
    Next

' 調整內容
    ExcelSheet.Columns("A:A").ColumnWidth = 18
    ExcelSheet.Columns("B:B").ColumnWidth = 90
    ExcelSheet.Columns("B:B").WrapText = True
    ExcelSheet.Range("B1:B" & ExcelSheet.Range("B65535").End(xlUp).Row).VerticalAlignment = xlTop
    ExcelSheet.Range("A1:B1").VerticalAlignment = xlCenter
    ExcelSheet.Range("A1:B1").HorizontalAlignment = xlCenter
    
'重新整理日期
    Set rngWrkRng = ExcelSheet.Range("A1:A" & ExcelSheet.Range("A65535").End(xlUp).Row + 1)
    
    For Each rngWrkCel In rngWrkRng
        If rngWrkCel <> "" Then
            rngWrkCel = rngWrkCel.Value2
        End If
    Next
    
ExcelSheet.Range("A1").Select
    
ExcelApp.SaveWorkspace

ExcelApp.DisplayAlerts = True
ExcelApp.ScreenUpdating = True

If Me.Toggle_Close_Export_File.Value = True Then
    ExcelApp.Quit
    ExcelApp.Application.Quit
End If


Set ExcelApp = Nothing


End Sub

「週報匯出」查詢的SQL語句：

SELECT Format(DailyWorkLog!DATE,"YYYY/M/D") & Chr(10) & Format(DailyWorkLog!DATE,"(aaaa)") AS 日期, DailyWorkLog!CONTENT & IIf(DailyWorkLog!SPEND_TIME=0,"",Format(DailyWorkLog!SPEND_TIME,"(0.0 hr.)")) AS 內容
FROM DailyWorkLog
WHERE (((DailyWorkLog.DATE) Between #5/5/2013# And #5/11/2013#) AND ((DailyWorkLog.DELETE)<>True) 

AND ((DailyWorkLog.TYPE) Not In (

SELECT DailyWorkLog_No_Export_Item.Value FROM DailyWorkLog_No_Export_Item WHERE (((DailyWorkLog_No_Export_Item.Item)="TYPE"))

)) AND ((DailyWorkLog.WORK) Not In (

SELECT DailyWorkLog_No_Export_Item.Value FROM DailyWorkLog_No_Export_Item WHERE (((DailyWorkLog_No_Export_Item.Item)="WORK"))

)) AND ((DailyWorkLog.SUBTYPE) Not In (

SELECT DailyWorkLog_No_Export_Item.Value FROM DailyWorkLog_No_Export_Item WHERE (((DailyWorkLog_No_Export_Item.Item)="SUBTYPE"))

)) AND ((DailyWorkLog.PROJECT_INDEX) Not In (

SELECT DailyWorkLog_No_Export_Item.Value FROM DailyWorkLog_No_Export_Item WHERE (((DailyWorkLog_No_Export_Item.Item)="PROJECT_INDEX"))

)))

ORDER BY DailyWorkLog.DATE, DailyWorkLog.TIME, DailyWorkLog.INDEX;